home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
PGM_TOOL
/
DUALEX
/
DUALEXE.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-08-08
|
11KB
|
340 lines
program DualEXE;
(*****************************************************************************)
(* *)
(* DUALEXE.PAS *)
(* 08/09/94 *)
(* Brad Stowers *)
(* CIS: 72733,3374 *)
(* Internet: brad.stowers@delta.com *)
(* *)
(* This code first appeared (as far as I know) in the May 1994 issue of *)
(* Windows/DOS Developers Journal in the Tech Tips section. It was written *)
(* and contributed by: *)
(* Paul Bixel *)
(* CIS: 71055,423 *)
(* Internet: Bixel_PS@salem.ge.com *)
(* All credit for this program go to Mr. Bixel. I did nothing more than *)
(* type it in (couldn't find it on the W/DDJ CIS forum library!), add the *)
(* prompting for parameters, the conditional defines for Windows, and the *)
(* primitive progress display. In the true spirit of DUALEXE, the included *)
(* version of DUALEXE.EXE runs equally well under DOS or Windows. *)
(* *)
(*****************************************************************************)
(* *)
(* Combine a Windows and a DOS app together to produce "dual-mode" *)
(* executable. This is an easy thing to do with most Windows C++ compilers *)
(* but we Pascalers have been denied this "nicety" by Borland. NO LONGER!! *)
(* Also, you needn't include just a DOS "stub" program. You can combine a *)
(* full-blown DOS app with your Windows app. *)
(* *)
(* Pass in three parameters in this order: *)
(* The DOS application file name and path. *)
(* The Windows application file name and path. *)
(* The file name and path you want the new EXE to have. *)
(* If any parameters are omitted, you will be prompted for them. *)
(* *)
(*****************************************************************************)
{$IFNDEF WINDOWS}
uses CRT;
{$ELSE}
uses WinCRT;
{$ENDIF}
type
{ Old style MSDOS header }
ExeHeader = record
Sig,
lpSize,
PgCnt,
rItems,
HdrSize,
MinAlloc,
MaxAlloc : word;
Data1 : LongInt;
ChkSum : word;
Data2 : array[$14..$17] of byte;
RTOfs,
OvrNum : word;
Data3 : array[$1C..$3B] of byte;
WinHdr : LongInt;
end;
{ New style Windows header }
NewHeader = record
Sig,
Ver,
ETOfs,
ETLen : word;
ChkSum : LongInt;
Flags : word;
Data1 : array[$0E..$1B] of byte;
StCnt : word;
Data2 : array[$1E..$21] of byte;
STOff,
RTOfs : word;
Data3 : array[$26..$2B] of byte;
NROff : LongInt;
EpCnt,
AsCnt,
RsCnt : Word;
OSFlg,
EXEFlg : byte;
FLOfs : word;
end;
{ Segment table records }
SegTabEntry = record
SegOff : word;
Data1 : array[2..7] of byte;
end;
{ Resource table group records }
ResGrpEntry = record
ResType,
ResCnt : word;
Data : array[4..7] of byte;
end;
ResTabEntry = record
ResOfs,
ResLen : word;
Data : array[4..11] of byte;
end;
var
fw, { Windows app input file }
fd, { Dos app input file }
fn: file; { New file output handle }
fwhdr,
fdhdr,
fnhdr: EXEHeader;
nh: NewHeader;
ResGrp: ResGrpEntry;
ResEnt: ResTabEntry;
buffer: array[1..1024*30] of byte;
i: word;
achange: integer;
dimage: longint;
alignment: word;
shcnt: word;
stent:SegTabEntry;
j: longint;
DosFileName,
WinFileName,
NewFileName: String;
SetIcon : boolean;
begin
(* Mr. Bixel's original code follows:
if ParamCount <> 3 then begin
WriteLn('DUAL-MODE executable creator. v1/1/93');
Writeln('Usage:');
Writeln(' dualexe <dosapp> <winapp | winicon> <newappname>');
exit;
end;
SetIcon := False;
FileName := ParamStr(2);
I := 1;
while Length(FileName) > i do begin
FileName[i] := UpCase(FileName[i]);
inc(i);
end;
if Pos(Filename, '.ICO') > 0 then begin
FileName := 'LAUNCH.EXE';
SetIcon := TRUE;
end;
assign(fd, ParamStr(1));
assign(fw, FileName);
assign(fn, ParamStr(3));
*)
writeln('DUAL-MODE executable creator. v1/1/93 by Paul Bixel');
writeln;
if (ParamStr(1) = '/?') or (ParamStr(1) = '?') or (ParamStr(1) = '-?') then begin
writeln('Usage:');
writeln(' dualexe <dosapp> <winapp | winicon> <newappname>');
exit;
end;
if ParamCount < 1 then begin
write('Enter DOS app file and path: ');
readln(DosFileName);
if DosFileName = '' then exit;
end else
DosFileName := ParamStr(1);
if ParamCount < 2 then begin
write('Enter Windows app (or icon) file and path: ');
readln(WinFileName);
if WinFileName = '' then exit;
end else
WinFileName := ParamStr(2);
SetIcon := False;
I := 1;
while Length(WinFileName) > i do begin
WinFileName[i] := UpCase(WinFileName[i]);
inc(i);
end;
if Pos(WinFilename, '.ICO') > 0 then begin
WinFileName := 'LAUNCH.EXE';
SetIcon := TRUE;
end;
if ParamCount < 3 then begin
write('Enter file and path for new executable: ');
readln(NewFileName);
if NewFileName = '' then exit;
end else
NewFileName := ParamStr(3);
writeln;
assign(fd, DosFileName);
assign(fw, WinFileName);
assign(fn, NewFileName);
reset(fw, 1);
reset(fd, 1);
rewrite(fn, 1);
BlockRead(fw, fwhdr, sizeof(fwhdr));
BlockRead(fd, fdhdr, sizeof(fdhdr));
{ Read the windows file New Header }
seek(fw, fwhdr.winhdr);
BlockRead(fw, nh, sizeof(nh));
{ New Old Style header most like DOS program's }
fnhdr := fdhdr;
{ Calculate the DOS load image size }
dimage := fdhdr.pgcnt*longint(512)+fdhdr.lpsize-fdhdr.hdrsize*longint(16)-longint(512);
fnhdr.rtofs := $40;
fnhdr.chksum := 0;
{ calc alignment shift }
shcnt := nh.ascnt mod 9;
if shcnt = 0 then shcnt := 9;
alignment := 1 shl shcnt;
{ where will new win header be? }
fnhdr.winhdr := (((filesize(fd) + $40 -fdhdr.rtofs + alignment - 1) shr shcnt) shl shcnt);
{ calculate the new header size in paragraphs }
fnhdr.hdrsize := ($40+fdhdr.ritems*4+15) div 16;
{ calculate new file size parameters }
fnhdr.lpsize := (fnhdr.hdrsize*16+dimage) mod 512;
fnhdr.pgcnt := (fnhdr.hdrsize*16+dimage+511) div 512;
{ write the old style header to the new file }
BlockWrite(fn, fnhdr, $40);
{ write the DOS relocation table }
seek(fd, fdhdr.rtofs);
if fdhdr.ritems > 0 then begin
BlockRead(fd, buffer, fdhdr.ritems*4);
BlockWrite(fn, buffer, fdhdr.ritems*4);
end;
{ write up to the next paragraph }
i := filepos(fn);
fillchar(buffer, sizeOf(buffer), #0);
if (i mod 16) <> 0 then
BlockWrite(fn, buffer, 16-(i mod 16));
{ Transfer entire DOS image }
write('Copying DOS app.');
seek(fd, fdhdr.hdrsize*16);
repeat
BlockRead(fd, buffer, sizeof(buffer), i);
if (i > 0) then BlockWrite(fn, buffer, i);
write('.');
until (i <> sizeof(buffer));
writeln;
{ Fill out the last page till the windows header }
if fnhdr.winhdr-filepos(fn) > 0 then begin
fillchar(buffer, sizeof(buffer), #0);
BlockWrite(fn, buffer, fnhdr.winhdr-filepos(fn));
end;
{ compute the adjustment for segment oriented offsets }
if fnhdr.winhdr >= fwhdr.winhdr then
achange := (fnhdr.winhdr - fwhdr.winhdr + alignment - 1) shr shcnt
else
achange := -((fwhdr.winhdr - fnhdr.winhdr + alignment - 1) shr shcnt);
{ Adjust the fast load area if used }
if (nh.exeflg and 8) > 0 then inc(nh.flofs,achange);
{ Adjust the new header name table offset }
nh.nroff := nh.nroff - fwhdr.winhdr + fnhdr.winhdr;
{ Blank the checksum }
nh.chksum := 0;
{ Insert the entire window application header and image }
write('Adding Windows app.');
Seek(fw, fwhdr.winhdr+sizeof(nh));
BlockWrite(fn, nh, sizeof(nh));
repeat
BlockRead(fw, buffer, sizeof(buffer), i);
if (i > 0) then BlockWrite(fn, buffer, i);
write('.');
until (i <> sizeof(buffer));
writeln;
{ Go back and fix segment table offsets }
seek(fn, fnhdr.winhdr+nh.stoff);
seek(fw, fwhdr.winhdr+nh.stoff);
while nh.stcnt > 0 do begin
BlockRead(fw, stent,sizeof(stent));
if (stent.segoff<>0) then inc(stent.segoff,achange);
BlockWrite(fn, stent, sizeof(stent));
dec(nh.stcnt);
end;
{ Now doctor up the resource tables offsets }
Seek(fw, fwhdr.winhdr+nh.rtofs);
seek(fn, fnhdr.winhdr+nh.rtofs+2);
BlockRead(fw, shcnt, 2);
alignment := 1 shl shcnt;
if fnhdr.winhdr >= fwhdr.winhdr then
achange := (fnhdr.winhdr - fwhdr.winhdr + alignment - 1) shr shcnt
else
achange := -((fwhdr.winhdr - fnhdr.winhdr + alignment - 1) shr shcnt);
write('Inserting resources.');
repeat
BlockRead(fn, resgrp, sizeof(resgrp));
BlockRead(fw, resgrp, sizeof(resgrp));
while (resgrp.restype <> 0) and (resgrp.rescnt > 0) do begin
BlockRead(fw, resent, sizeof(resent));
inc(resent.resofs, achange);
BlockWrite(fn, resent, sizeof(resent));
dec(resgrp.rescnt);
write('.');
end;
until (resgrp.restype = 0);
writeln;
writeln;
writeln('Finished. ', NewFileName, ' written. New size is ', filesize(fn), ' bytes.');
{ Done so close everyone up }
Close(fn);
Close(fd);
Close(fw);
end.